COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C00018 ENDMK
C⊗;
C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
C *** READS DATA FROM DSK FOR VARIOUS THINGS.
C*** UNKNOWN, ENDIT, ILLEGL, TOOMCH, PLTCMD, SLUR, NAMEXT

	COMMON /DL/IXRX,SAVER,NAME,EXT /FRMT/F78F(1),FA1(1),FA5(1),ASK
	1 /LIMIT/LIMIT,ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C					   ↓↓↓↓↓ V IS FOR READIN ONLY
C%%%%%%%%
	COMMON /STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,POS
	1 /PTR/PWDS(350)
	1/PLTR/PLT,RHT,DIS,XDIS
	COMMON /XRN/ RN(3000),V(3000) /ALF/INP(72),ML /SSS/SSS(200)
	1 /SLR/SLURX(272) 
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
CC	DATA DIS/1.24/
	DIS=1.24 
C 1.24 IS FACTOR FOR 8 1/2 X 11 PAGE.
C*****	CALL SEGFIX
C  TO ENABLE MULTIPLE USE OF UPPER SEGMENT (TVR)
	CALL MPRFAI
	END    

C***** SOME TYPEOUT AND ACCEPT ROUTINES *******

CC	SUBROUTINE WHY      
CC	END

	SUBROUTINE UNKNWN(JA)
	CALL TYPSTR('UNKNOWN CODE =')
	CALL TYPINT(JA)
	CALL TYPCRLF
CCC	TYPE 5700,JA
CCC5700	FORMAT(' UNKNOWN CODE=',I3)
C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".
	END

	SUBROUTINE ENDIT(A,ITMS)
	COMMON /OUTF/JJ,KOUT
CCC	TYPE 300,A,ITMS,KOUT
	CALL TYPFLT(A)
	CALL TYPSTR(' INCHES. ')
	CALL TYPINT(ITMS)
	CALL TYPSTR(' ITEMS.    ')
	CALL TYPWRD(KOUT)
	CALL TYPSTR('.PLT')
	CALL PLOT(0,0,99)
C  THE END OF THE DATA
CCC300	FORMAT(F7.2,' INCHES',I,' ITEMS ',9X,A5,'.PLT')
C  THE END OF THE DATA
	END

	SUBROUTINE ILLEGL(JA)
CCC	TYPE 160,JA
CCC160	FORMAT(' ILLEGAL STAFF# ',I4)
	CALL TYPSTR('ILLEGAL STAFF# ')
	CALL TYPINT(JA)
	CALL TYPCRLF
	END

	SUBROUTINE TOOMCH(K)
	CALL TYPSTR('***** TOO MUCH DATA ***** ')
	CALL TYPINT(K)
	CALL TYPSTR('/3000')
CCC	TYPE 4202,K
	STOP
CCC4202	FORMAT(' ***** TOO MUCH DATA ',I6,'/2500')
	END

CCCCCCCCCCCCCCCCCCC  SUBRS.  SLUR, PLTSRT, (LINES, RDRAW),PLTCMD

	SUBROUTINE PLTCMD(NOSET)
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /OUTF/JJ,KOUT
	DIMENSION NMS(20),RMOV1(20),RMOV2(20)
C**** NO MORE THAN 20 FILES PER PAGE **** (COULD BE INCREASED)
	COMMON /DL/RSIZ,SAVER,NAME,EXT /ALF/INP(72),ML
	COMMON R2,JE,CENTR,JB,RJQ(20),JQ(20)
	EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
	1,(R3,RJQ(1)),(I2,INP(2)),(R8,RJQ(6)),(R9,RJQ(7)),(NMS(1),NM1)
C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
CC	F78F(1)='(78F)'
CC	FA5(1)='(A5) '
	DATA FA1(1)/'(A1) '/,F78F(1)/'(78F)'/,EXT/'DMD'/

	IF(I2.NE.'%')GO TO 1
CC	IF(I2.NE.'X')GO TO 1
	I2=0
C  I2=% FIRST TIME THROUGH  (WAS X, BEFORE 2/78)
	RXC=0
	RMOV1(1)='Y'
	NAME=0
14	KA=0
3	KA=KA+1
	IF(MLL.EQ.0)GO TO 15
	K=K-2
	MLL=MLL-1
	IF(MLL.NE.0)GO TO 31
	IF(MORE)GO TO 10
C ADD 100 TO RSPC TO READ IN NEW ALPHABETICAL SERIES OF FILES.
CC	IF(MLL.EQ.0)GO TO 10
CC	GO TO 31
CCC15	TYPE 2,KA
15	CALL TYPSTR('TYPE FILE NAME')
	CALL TYPINT(KA)
	CALL TYPSTR(' ')
CF	ACCEPT 11,K,MLL,RSPC
C  TYPE FIRST NAME, NUMBER  FOR A SERIES, 2ND NUM FOR FIXED SPACE ".
	CALL NAMEXT(K,EXT,MLL,RSPC)
CF	REREAD 351,JJ,R8 
	MORE=-1
	IF(RSPC.LT.100)GO TO 30
	MORE=0
	RSPC=RSPC-100.
30	IF(KA.LT.21)GO TO 155
	CALL TYPSTR('****ONLY 20 FILES ACCEPTED****')
	GO TO 10
155	IF(K.NE.' ')GO TO 51
	IF(KA.NE.1)GO TO 10
C  DEFAULT NAME IS 'TMP    1'
	K='TMP'
	MLL=1
51	IF(K.EQ.'99')GO TO 140
	IF(KA.EQ.1)NM1=K
C  99=BACKUP
CZZ	IF(JJ.NE.'EXT ')GO TO 251
C TYPE 'EXT XXX' TO READ FILES WITH EXTENSION .XXX
CZZ	EXT=R8
CZZ	GO TO 15
CC351	FORMAT(A4,A3)
251	IF(MLL.GE.99)GO TO 151
	IF(MLL.EQ.0)GO TO 151
	K=K+2*(MLL-1)
C THIS CHANGES GIVEN NAME TO LAST OF SERIES.
C I.E. AAAAA 5  WILL GET AAAAE FIRST AND WORK BACKWARDS.
151	IF(K.NE.'NOSET')GO TO 31
	NOSET=-1
C  ACTIVATES ANTI-RESET IN MPRFAI.FAI
	GO TO 15

31	IF(LOOKX(K,EXT))GO TO 56
C JUMP IF FILE FOUND
	CALL TYPSTR('FILE NOT FOUND')
	CALL TYPCRLF
CCC	TYPE 55
	GO TO 15
CCC55	FORMAT(' FILE NOT FOUND'/)
11	FORMAT(A5,I,F)
56	IF(MLL.LT.99)GO TO 560
	MLL=0 
561	K=K+2
C  TYPE 'AAAAA 99'  TO FIND ALL IN 'AAAAx' SERIES AUTOMATICALLY
	MLL=MLL+1
	IF(LOOKX(K,EXT))GO TO 561
C  KEEPS GOING BACK IF FILES ARE FOUND
	K=K-2
	CALL TYPSTR('READING FILES --- ')
	CALL TYPWRD(NM1)
	CALL TYPCHR('.',1)
	CALL TYPWRD(EXT)
	CALL TYPCHR('THRU  ',6)
	CALL TYPWRD(K)
	CALL TYPCRLF
CCC	TYPE 1560,NM1,EXT,K
CCC1560	FORMAT(' READING FILES--- ',A5,'.',A3,' THRU ',A5/)
560	NMS(KA)=K
	IF(MLL.EQ.0)GO TO 5
	R8='Y'
	IF(RSPC.NE.0)R8=RSPC
	GO TO 21
5	CALL TYPSTR('MOVE UP AT END? ')
CCC5	TYPE 8
	ACCEPT 11,R8
	IF(R8.EQ.'99')GO TO 15
	CALL LO2UP(R8)
	IF(R8.NE.'Y')R8=0
	IF(R8.EQ.0)REREAD F78F,R8
C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
21	RMOV1(KA+1)=R8
	RMOV2(KA)=R8
	GO TO 3
140	KA=KA-1
	GO TO 15

10	KB=KA-1
CC	IF(I3.NE.'G')GO TO 22
CC	RSIZ=1
CC	GO TO 222
22  	CALL TYPSTR('SIZE FACTOR? ')
CCC22	TYPE 9
	ACCEPT F78F,RSIZ,R9
C  SET R9 TO 1 FOR HEAVY STAFF LINES (FOR XGP MAINLY)
	IF(RSIZ.EQ.99)GO TO 5
	IF(RSIZ.EQ.0)RSIZ=1.
	CALL TYPSTR('TYPE OUTPUT NAME - ')
CCC	TYPE 550
	ACCEPT 11,JJ
	CALL LO2UP(JJ)
	IF(JJ.EQ.' ')JJ='PLT'
	KOUT=JJ
CCC550	FORMAT(' TYPE OUTPUT NAME - '$)
222	KA=0

1	IF(NAME.NE.0)GO TO 12
	IF(KA.NE.KB)GO TO 13
	I2=-1
	RETURN
C  THE END OF THE DATA
13	NAME=NMS(KA+1)
	CALL TYPWRD(NAME)
	CALL TYPCHR('.',1)
	CALL TYPWRD(EXT)
	CALL TYPCRLF
CCC	TYPE 111,NAME,EXT
	RETURN
12	KA=KA+1
	NAME=0
	R8=0
	R2=RSIZ
	R3=RSIZ
C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
	R7=0
	R5=1
	R6=1
	IF(RMOV2(KA).NE.'Y')R7=RMOV2(KA)
	IF(RMOV1(KA).NE.0)R5=0
	IF(RMOV2(KA).NE.0)GO TO 77
	IF(R7.EQ.0)RETURN
77	R6=0
CCC2	FORMAT(' TYPE FILE NAME',I2,1X$)
CCC8	FORMAT(' MOVE UP AT END? ',$)
CCC9	FORMAT(' SIZE FACTOR? ',$)
CCC111	FORMAT(1XA5,'.',A3/)
	END


	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON /ALF/INP,SLURY(72) /SSS/ SSS(200) /SLR/ SLURX(1)  
	REAL CENTR
	COMMON /PLTR/PLT,RHT,RDIS,XDIS
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(7),R,RJ
	1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX /STF/RSTFAC(0/7),RSTJ2
CF	DATA RZZ/2.8/
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8

2	J10=1
	J4=0
	KQ=5 
	TWICE=-1
C  -1 FOR DISPLAY, USES ONLY 1/3 OF SEGMENTS
	IF(PLT.GE.0)GO TO 21
	TWICE=0
	KQ=1
	RWID=.2
	IF(RHT.LT.2)GO TO 21
	TWICE=1
	RWID=.14
C  IF SIZE IS GT.2 3 SLURS ARE DRAWN
	IF(RHT.LT.3)GO TO 21
	TWICE=2
C  IF SIZE IS GE.3 4 SLURS ARE DRAWN
	RWID=.1
21	RST7=RSTJ2*7.
	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
5	R=30
CC5	R=32
C AFTER DOTTED NOTE
	GO TO 8
CC6	R=18
6	R=22
C BETWEEN NOTES
8	RX=-0.75
CC8	RX=-1.3
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX*RXX+RTILT*RTILT)
	IF(J8.NE.-1)GO TO 10
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
CCCC	RQQ=RQQ*RSTFAC(J2)
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ*RSTJ2
CCCC	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
10	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	IF(RJ.GE.300)RJ=0
	R7=AMOD(R7,100.0)
	R=RDIS*RX*.4
	L=R
	L=L*2
C TO INSURE AN EVEN NUMBER OF VECTORS (ONLY 1/2 ARE COMPUTED IN SLOOP)
	IF(L.LT.60)L=60
	IF(L.GT.272)L=272
	IF(J11.EQ.0)GO TO 1
	R=R*2
	RZ=L-60
	J11=RZ * 10./212. +7.
	RXXX=.02
111	IF(R.GT.272)J11=J11-RXXX*(R-272)
 	IF(J11.LT.7)J11=7
11	IF(MOD(L/J11,2).NE.0)GO TO 1
C TO INSURE AN UNEVEN NUMBER OF SEGMENTS (SO THE LAST IS BLACK)
	J11=J11+1
	GO TO 11
CC	J11=R/7. 
CC	IF(J11.LT.7)J11=7
CC	IF(J11.GT.39)J11=39
CC	J11=RDIS*L/J11
C FOR DASHED SLURS  
C  L=NUMB OF SEGMENTS IN THE CURVE.

1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	CALL SLOOP

	IF(J4.NE.0)GO TO 83
87	CALL LINES(SLURX(J10),SLURY(J10),3)
	IF(J11.EQ.0)J4=-1
83	J5=KQ
	J6=J10
	J7=L
	IF(J11.NE.0)GO TO  122
	IF(J4)GO TO 22
	J6=L
	J7=J10
	J5=-1
22	DO 88 K=J6,J7,J5
88	CALL LINES(SLURX(K),SLURY(K),2)
	GO TO 123

122	KD=2
	KT=0
	KA=1
C THIS WILL MAKE DASHED SLURS  J11 HAS DASH SIZE.
	DO 188 K=J6,J7,J5
	KT=KT+1
	IF(KT.LT.J11)GO TO 188
	KT=0
	KD=KD+KA
	KA=-KA
C  BLANK-DASH FLIP-FLOP
188	CALL LINES(SLURX(K),SLURY(K),KD)

123	IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
	IF(TWICE)RETURN
	TWICE=TWICE-1
	IF(J8.GT.0)GO TO 182
	J4=-J4
	R7=R7+RWID
C  RWID=WIDTH OF SLUR -- SEE DATA
	GO TO 1
180	RW=R+R7*RST7
	TWICE=-1
	KQ=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	TWICE=2
	RZ=RTILT/(RX-R3)
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
CC	TWICE=-1
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=0.875
C .875 IS SIZE OF NUM.   R7=1 MAKES ITALIC FONT
	R7=1.
	R8=0
	CALL MAKNUM(R9)
	END
C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY

	SUBROUTINE NAMEXT(NAME,EXT,NUM,SPC)
	COMMON /ALF/INP(72)
	DIMENSION FORM2(5),FORMT(5),NUMS(30)
	DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
	1, FORM3/'I,F)'/
	EQUIVALENCE (F1,FORMT(1)),(F2,FORMT(2)),(F3,FORMT(3)),
	1 (F4,FORMT(4)),(F5,FORMT(5))
1	FORMAT(72A1)
	ACCEPT 1,INP
	DO 2 K=2,72
	IF(INP(K).EQ.' ')GO TO 3
2	IF(INP(K).EQ.'.')GO TO 4
3	F3=FORM3
	F4=' '
	F5=' '
5	F2=FORM2(K-1)
	REREAD FORMT,NAME,NUM,SPC
	GO TO 10
4	FORMT(3)=FORM2(1)
C  CATCHES DOT
	DO 7 N=K+1,72
7	IF(INP(N).EQ.' ')GO TO 8
8	F4=FORM2(N-K-1)
	F5=FORM3
	F2=FORM2(K-1)
	REREAD FORMT,NAME,K,EXT,NUM,SPC
	CALL LO2UP(EXT)
10	CALL LO2UP(NAME)
	END